Caption = "Please mail me your comments and suggestions!"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = -74280
MouseIcon = "Main.frx":0ED2
MousePointer = 99 'Custom
TabIndex = 45
Top = 2640
Width = 4125
End
Begin VB.Label Label15
AutoSize = -1 'True
Caption = "
1999 Alexandre Moro"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = -73200
TabIndex = 44
Top = 1800
Width = 2010
End
Begin VB.Label Label14
Alignment = 2 'Center
Caption = " "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
Left = -74880
TabIndex = 42
Top = 2880
Width = 5400
WordWrap = -1 'True
End
Begin VB.Label Label13
Alignment = 2 'Center
Caption = " "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 480
Left = -74880
TabIndex = 41
Top = 2280
Width = 5400
WordWrap = -1 'True
End
Begin VB.Label Label12
Alignment = 2 'Center
Caption = " "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = -74880
TabIndex = 40
Top = 1800
Width = 5400
End
Begin VB.Label Label11
Alignment = 2 'Center
Caption = " "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 480
Left = -74880
TabIndex = 39
Top = 1200
Width = 5400
WordWrap = -1 'True
End
Begin VB.Label Label10
Alignment = 2 'Center
Caption = " "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = -74880
TabIndex = 38
Top = 720
Width = 5400
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Files / Directories to be copied:"
Height = 195
Left = -74880
TabIndex = 37
Top = 480
Width = 2205
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Destiny directory:"
Height = 195
Left = -74640
TabIndex = 36
Top = 480
Width = 1215
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Backup when..."
Height = 195
Left = 240
TabIndex = 35
Top = 480
Width = 1125
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "hours:minutes"
Height = 195
Left = 2640
TabIndex = 34
Top = 1335
Width = 975
End
Begin MSForms.OptionButton OptionButton1
Height = 345
Left = 1560
TabIndex = 33
Top = 900
Width = 405
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "714;609"
Value = "1"
GroupName = "a"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "hours:minutes"
Height = 195
Left = 2640
TabIndex = 32
Top = 975
Width = 975
End
Begin MSForms.OptionButton OptionButton3
Height = 345
Left = 1560
TabIndex = 31
Top = 2100
Width = 750
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "1323;609"
Value = "1"
Caption = "Daily"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox2
Height = 345
Index = 2
Left = 1560
TabIndex = 30
Top = 2460
Width = 975
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "1720;609"
Value = "0"
Caption = "Monday"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox2
Height = 345
Index = 3
Left = 2880
TabIndex = 29
Top = 2460
Width = 1020
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "1799;609"
Value = "0"
Caption = "Tuesday"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox2
Height = 345
Index = 4
Left = 4080
TabIndex = 28
Top = 2460
Width = 1260
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "2222;609"
Value = "0"
Caption = "Wednesday"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox2
Height = 345
Index = 5
Left = 1560
TabIndex = 27
Top = 2820
Width = 1065
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "1879;609"
Value = "0"
Caption = "Thursday"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox2
Height = 345
Index = 6
Left = 2880
TabIndex = 26
Top = 2820
Width = 825
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "1455;609"
Value = "0"
Caption = "Friday"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox2
Height = 345
Index = 7
Left = 4080
TabIndex = 25
Top = 2820
Width = 1035
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "1826;609"
Value = "0"
Caption = "Saturday"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox2
Height = 345
Index = 1
Left = 1560
TabIndex = 24
Top = 3180
Width = 945
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "1667;609"
Value = "0"
Caption = "Sunday"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "When:"
Height = 195
Left = 960
TabIndex = 23
Top = 2175
Width = 480
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "Always at:"
Height = 195
Left = 720
TabIndex = 22
Top = 975
Width = 720
End
Begin MSForms.OptionButton OptionButton2
Height = 345
Left = 1560
TabIndex = 21
Top = 1260
Width = 405
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 5
Size = "714;609"
Value = "0"
GroupName = "a"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "Or each:"
Height = 195
Left = 825
TabIndex = 20
Top = 1335
Width = 615
End
Begin VB.Label Label9
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "(interval initiated from now, or when the application starts)"
Height = 390
Left = 1560
TabIndex = 19
Top = 1620
Width = 2580
WordWrap = -1 'True
End
Begin MSForms.CheckBox CheckBox1
Height = 345
Left = 360
TabIndex = 18
Top = 3540
Width = 1275
VariousPropertyBits= 1015023643
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "2249;609"
Value = "1"
Caption = "Save log file"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox3
Height = 495
Left = -74760
TabIndex = 17
Top = 3825
Width = 1215
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "2143;873"
Value = "1"
Caption = "Include Subdirs"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.CheckBox CheckBox4
Height = 375
Left = 360
TabIndex = 16
Top = 3960
Width = 2055
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "3625;661"
Value = "0"
Caption = "Incremental backup"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
End
Begin VB.Menu mnu_1
Caption = "mnu_1"
Visible = 0 'False
Begin VB.Menu MnuRestore
Caption = "Restore"
End
Begin VB.Menu MnuBackup
Caption = "Backup now!"
End
Begin VB.Menu MnuQuit
Caption = "Quit"
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'********** Auto Backup ***********
'*******
1999 Alexandre Moro *******
'You can freely distribute this source code,
' but if you do any modification please
' let me know!
' Comments and suggestions:
' alb@cwb.matrix.com.br
Dim NLoops As Integer, LoopDup As Integer, ListWithFocus As Boolean, Days As Byte
Dim sRet As String, Ret As Long, MskErr1 As Boolean, MskErr2 As Boolean
Dim DestinyDir As String, NoIniArchive As Boolean
Dim WindowsDir As String, NLoopsTimer As Byte, Interval As Date, IniTime As Date
Dim Default As Boolean, LastBackup As Date, Result As Long, Msg As Long, OpenError As Boolean
Dim XDir(2) As New Collection, FromPath As String
Private Const Arq = "Autobak.ini"
Private Const SW_SHOW = 5
Private Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As String, ByVal lpFileName As String)
Private Declare Function GetPrivateProfileString& Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String)
Private Declare Function GetWindowsDirectory& Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private nid As NOTIFYICONDATA
Private Type ListaArqs
Nome As String
Tamanho As Long
End Type
Private Files() As ListaArqs
Private Sub GetDirs(Path As String)
'on error Resume Next
Dim vDirName As String, LastDir As String
Dim i As Integer
'Adjust so No Deletion of Drive
If Len(Path$) < 4 Then Exit Sub
If Right(Path$, 1) <> "\" Then
XDir(0).Add Path$
Path$ = Path$ & "\"
End If
vDirName = Dir(Path, vbDirectory) ' Retrieve the first entry.
Do While vDirName <> ""
If vDirName <> "." And vDirName <> ".." Then
If (GetAttr(Path & vDirName)) = vbDirectory Then
LastDir = vDirName
'Finds Directory Name then Repeats
GetDirs (Path$ & vDirName)
vDirName = Dir(Path$, vbDirectory)
Do Until vDirName = LastDir Or vDirName = ""
vDirName = Dir
Loop
If vDirName = "" Then Exit Do
End If
End If
vDirName = Dir
Loop
End Sub
Private Function ExtractText(FullText As String, token As String, Optional StartAtLeft = True, Optional IncludeLeftSide = True) As String
'ExtractText(Path$, ":", False, False)
Dim i As Integer
If StartAtLeft = True And IncludeLeftSide = True Then
ExtractText = FullText
For i = 1 To Len(FullText)
If Mid(FullText, i, 1) = token Then
ExtractText = Left(FullText, i - 1)
Exit Function
End If
Next
ElseIf StartAtLeft = True And IncludeLeftSide = False Then
ExtractText = FullText
For i = 1 To Len(FullText)
If Mid(FullText, i, 1) = token Then
ExtractText = Right(FullText, Len(FullText) - i)
Exit Function
End If
Next
ElseIf StartAtLeft = False And IncludeLeftSide = True Then
ExtractText = ""
For i = Len(FullText) To 1 Step -1
If Mid(FullText, i, 1) = token Then
ExtractText = Left(FullText, i - 1)
Exit Function
End If
Next
ElseIf StartAtLeft = False And IncludeLeftSide = False Then
(.txt)